home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-0039 / source / dcconvrt.mod < prev    next >
Text File  |  1997-04-16  |  17KB  |  516 lines
  1. IMPLEMENTATION MODULE DCConvrt;
  2.  
  3.  
  4. (*----------------------------------------------------------------------*)
  5. (* This module will need to access the screen display routines.         *)
  6. (*----------------------------------------------------------------------*)
  7.  
  8.  
  9.  
  10. (*--------------------------------------------------------------------*)
  11. (* Amendments:                                                        *)
  12. (* 25/ 8/89 LGM : Changed to use new Picture conversion routines.     *)
  13. (*                Make print patterns for equal colours the same.     *)
  14. (*                                                                    *)
  15. (*--------------------------------------------------------------------*)
  16.  
  17. (*  IMPORT Trace; *) 
  18.  
  19. FROM   SYSTEM        IMPORT ADR, ADDRESS;
  20.  
  21. FROM   Strings          IMPORT String, Concat, Assign;
  22.  
  23. FROM QSort        IMPORT SortArrayWithKeys;
  24.  
  25. IMPORT Forms;
  26.  
  27.  
  28. IMPORT DCPicCnv;  (* low-level picture conversion routines *)
  29.  
  30.  
  31. FROM   DCScreen         IMPORT  DisplayPicture;
  32.  
  33. FROM   DCQScrn          IMPORT  ClearScreen;
  34.  
  35. FROM   DCGlobal         IMPORT  (* Constants *)
  36.                                 LowRes,
  37.                                 MedRes,
  38.                                 HiRes,
  39.  
  40.                                 LowResMaxX,
  41.                                 LowResMaxY,
  42.  
  43.                                 MedResMaxX,
  44.                                 MedResMaxY,
  45.  
  46.                                 HiResMaxX,
  47.                                 HiResMaxY,
  48.  
  49.                                 LowResScreen,
  50.                                 MedResScreen,
  51.                                 HiResScreen,
  52.  
  53.                                 BitPlanesEnum,
  54.                                 HiResLinePixelGroups,
  55.                                 MedResLinePixelGroups,
  56.                                 LowResLinePixelGroups,
  57.  
  58.                                 DegasPicture,
  59.  
  60.                                 PrintPalette,
  61.                                 Palette,
  62.                                 PaletteEntry,
  63.                                 PrintBitPatternSet;
  64.  
  65. FROM   ManyWindows    IMPORT     ShowAlert;
  66.  
  67. FROM   Graphics         IMPORT graf_mouse;
  68.  
  69.  
  70. TYPE
  71.     PaletteEntryPtr = POINTER TO PaletteEntry;
  72.  
  73. CONST
  74.    CLinesToDisplay      = 20;
  75.  
  76.    Arrow        =  0;
  77.    HourGlass        =  2;
  78.  
  79.  
  80. PROCEDURE NullFill( VAR s : ARRAY OF CHAR );
  81.  VAR i : INTEGER;
  82.  BEGIN
  83.    FOR i := 0 TO SHORT(HIGH(s)) DO s[i] := 0C; END;
  84.  END NullFill;
  85.  
  86.  
  87. PROCEDURE ConvertDegasToHiRes ( VAR inpicture,
  88.                                     outpicture      : DegasPicture;
  89.                                 VAR printpalette    : PrintPalette );
  90.   VAR Dumc : CARDINAL;
  91.   BEGIN
  92.     Dumc := graf_mouse( HourGlass, NIL);
  93.     IF inpicture.resolution = MedRes THEN
  94.       ConvertMedDegasToHiRes ( inpicture, outpicture, printpalette );
  95.  
  96.     ELSIF inpicture.resolution = LowRes THEN
  97.       ConvertLowDegasToHiRes ( inpicture, outpicture, printpalette );
  98.  
  99.     ELSE
  100.           outpicture := inpicture;
  101.  
  102.     END; (* if *)
  103.     Dumc := graf_mouse( Arrow, NIL);
  104.   END ConvertDegasToHiRes;
  105.  
  106.  
  107. (*----------------------------------------------------------------------*)
  108. (* PrintPalette will already have been set up                           *)
  109. (*----------------------------------------------------------------------*)
  110. PROCEDURE ConvertMedDegasToHiRes ( VAR inpicture,
  111.                                        outpicture   : DegasPicture;
  112.                                    VAR printpalette : PrintPalette );
  113.   VAR i         : INTEGER;
  114.   BEGIN
  115.     ClearPicture( outpicture );
  116.  
  117.     FOR i := 0 TO MedResMaxY DO
  118.        DCPicCnv.ConvertMedToHiResOneLine( inpicture, outpicture,
  119.                                           printpalette, i);
  120.        IF ( i MOD CLinesToDisplay ) = 0 THEN
  121.           DisplayPicture ( outpicture.HiResPicture );
  122.        END; (* if *)
  123.     END; (* for i *)
  124.     DisplayPicture ( outpicture.HiResPicture );
  125.   END ConvertMedDegasToHiRes;
  126.  
  127.  
  128. PROCEDURE ConvertLowDegasToHiRes ( VAR inpicture,
  129.                                        outpicture   : DegasPicture;
  130.                                    VAR printpalette : PrintPalette );
  131.   VAR i : INTEGER;
  132.  
  133.   BEGIN
  134.     ClearPicture( outpicture );
  135.  
  136.     FOR i := 0 TO LowResMaxY DO
  137.        DCPicCnv.ConvertLowToHiResOneLine( inpicture, outpicture,
  138.                                            printpalette, i);
  139.        IF ( i MOD CLinesToDisplay ) = 0 THEN
  140.           DisplayPicture ( outpicture.HiResPicture );
  141.        END; (* if *)
  142.     END; (* for i *)
  143.     DisplayPicture ( outpicture.HiResPicture );
  144.   END ConvertLowDegasToHiRes;
  145.  
  146.  
  147.  
  148. PROCEDURE ClearPicture ( VAR picture : DegasPicture );
  149.   VAR i,j : INTEGER;
  150.   BEGIN
  151.     picture.resolution := HiRes;
  152.  
  153.     picture.HiPalette[0] := 1;
  154.     picture.HiPalette[1] := 0;
  155.  
  156.     ClearScreen(picture.HiResPicture);
  157.   END ClearPicture;
  158.  
  159.  
  160.  
  161. PROCEDURE ShowLowResPixelIndex( x, y                : INTEGER;
  162.                                 screenres           : INTEGER;
  163.                                 VAR inpicture       : DegasPicture;
  164.                                 VAR pp              : PrintPalette );
  165.   CONST
  166.     Crgb        = 'RGB = ';
  167.     Cindex      = 'Index = ';
  168.     Cpp         = 'Pattern = ';
  169.     Cspace      = '    ';
  170.  
  171.   VAR
  172.     s, temps   : String;
  173.     i, j       : INTEGER;
  174.  
  175.   BEGIN
  176.     IF screenres = HiRes THEN
  177.        x := x DIV 2;  y := y DIV 2;
  178.     ELSE
  179.        x := x DIV 2;
  180.     END;
  181.  
  182.     i := DCPicCnv.QueryXYLowResPixelIndex( x, y, inpicture);
  183.  
  184.     NullFill(s);
  185.     Assign(Crgb,s);
  186.     NullFill(temps);
  187.     temps[0] := CHR( CARDINAL(pp[i].RedComponent)   + ORD('0') );
  188.     temps[1] := CHR( CARDINAL(pp[i].GreenComponent) + ORD('0') );
  189.     temps[2] := CHR( CARDINAL(pp[i].BlueComponent)  + ORD('0') );
  190.     Concat(s,temps,s);
  191.     Concat(s,Cspace,s);
  192.  
  193.     Concat(s,Cindex,s);
  194.     NullFill(temps);
  195.     j := pp[i].ColourIndex;
  196.     IF j > 9 THEN
  197.       temps[0] := '1';
  198.       j := j - 10;
  199.     ELSE
  200.       temps[0] := '0';
  201.     END;
  202.     temps[1] := CHR( CARDINAL(j) +  ORD('0') );
  203.     Concat(s,temps,s);
  204.     Concat(s,Cspace,s);
  205.  
  206.     Concat(s,Cpp,s);
  207.     Assign('0000',temps);
  208.     IF 0 IN pp[i].PrintBitPattern THEN temps[3] := '1' END;
  209.     IF 1 IN pp[i].PrintBitPattern THEN temps[2] := '1' END;
  210.     IF 2 IN pp[i].PrintBitPattern THEN temps[1] := '1' END;
  211.     IF 3 IN pp[i].PrintBitPattern THEN temps[0] := '1' END;
  212.     Concat(s,temps,s);
  213.  
  214.     j := ShowAlert(s,1,1);
  215.   END ShowLowResPixelIndex;
  216.  
  217.  
  218.  
  219. PROCEDURE ShowMedResPixelIndex( x, y                : INTEGER;
  220.                                 screenres           : INTEGER;
  221.                                 VAR inpicture       : DegasPicture;
  222.                                 VAR pp              : PrintPalette );
  223.    CONST
  224.     Crgb        = 'RGB = ';
  225.     Cindex      = 'Index = ';
  226.     Cpp         = 'Pattern = ';
  227.     Cspace      = '    ';
  228.  
  229.   VAR
  230.     s, temps   : String;
  231.     i, j       : INTEGER;
  232.  
  233.   BEGIN
  234.     IF screenres = HiRes THEN
  235.        y := y DIV 2;
  236.     END;
  237.  
  238.     i := DCPicCnv.QueryXYMedResPixelIndex( x, y, inpicture);
  239.  
  240.     NullFill(s);
  241.     Assign(Crgb,s);
  242.     NullFill(temps);
  243.     temps[0] := CHR( CARDINAL(pp[i].RedComponent)   + ORD('0') );
  244.     temps[1] := CHR( CARDINAL(pp[i].GreenComponent) + ORD('0') );
  245.     temps[2] := CHR( CARDINAL(pp[i].BlueComponent)  + ORD('0') );
  246.     Concat(s,temps,s);
  247.     Concat(s,Cspace,s);
  248.  
  249.     Concat(s,Cindex,s);
  250.     NullFill(temps);
  251.     j := pp[i].ColourIndex;
  252.     IF j > 9 THEN
  253.       temps[0] := '1';
  254.       j := j - 10;
  255.     ELSE
  256.       temps[0] := '0';
  257.     END;
  258.     temps[1] := CHR( CARDINAL(j) +  ORD('0') );
  259.     Concat(s,temps,s);
  260.     Concat(s,Cspace,s);
  261.  
  262.     Concat(s,Cpp,s);
  263.     Assign('0000',temps);
  264.     IF 0 IN pp[i].PrintBitPattern THEN temps[3] := '1' END;
  265.     IF 1 IN pp[i].PrintBitPattern THEN temps[2] := '1' END;
  266.     IF 2 IN pp[i].PrintBitPattern THEN temps[1] := '1' END;
  267.     IF 3 IN pp[i].PrintBitPattern THEN temps[0] := '1' END;
  268.     Concat(s,temps,s);
  269.  
  270.     j := ShowAlert(s,1,1);
  271.  END ShowMedResPixelIndex;
  272.  
  273.  
  274. (*----------------------------------------------------------------------*)
  275. (*  Split colour value into its red, green and blue components.         *)
  276. (*----------------------------------------------------------------------*)
  277. PROCEDURE ColourComponents (     colour           : INTEGER;
  278.                              VAR red, green, blue : INTEGER );
  279.   CONST
  280.     CLeftShift4 = 16;
  281.     CColourComponentMask = {13,14,15};
  282.  
  283.   BEGIN
  284.     blue := INTEGER ( BITSET(colour) * CColourComponentMask );
  285.     colour := colour DIV CLeftShift4;
  286.     green := INTEGER ( BITSET(colour) * CColourComponentMask );
  287.     colour := colour DIV CLeftShift4;
  288.     red := INTEGER ( BITSET(colour) * CColourComponentMask );
  289.    END ColourComponents;
  290.  
  291.  
  292. PROCEDURE CountPBPBits( bits : PrintBitPatternSet ) : CARDINAL;
  293.   VAR cnt : CARDINAL;
  294.   BEGIN
  295.     cnt := 0;
  296.     IF 0 IN bits THEN INC(cnt); END;
  297.     IF 1 IN bits THEN INC(cnt); END;
  298.     IF 2 IN bits THEN INC(cnt); END;
  299.     IF 3 IN bits THEN INC(cnt); END;
  300.     RETURN cnt;
  301.   END CountPBPBits;
  302.  
  303. PROCEDURE CompareComponents( PE1Ptr, PE2Ptr : PaletteEntryPtr ) : BOOLEAN;
  304.   VAR colour1, colour2 : CARDINAL;
  305.       result           : BOOLEAN;
  306.   BEGIN
  307.          result := FALSE;
  308.  
  309.          WITH PE1Ptr^ DO
  310.            colour1 := (   ( RedComponent   *   100   )
  311.                         + ( GreenComponent *    10   )
  312.                         + ( BlueComponent  *     1   ) )
  313.          END; (* with *)
  314.  
  315.          WITH PE2Ptr^ DO
  316.            colour2 := (   ( RedComponent   *   100   )
  317.                         + ( GreenComponent *    10   )
  318.                         + ( BlueComponent  *     1   ) )
  319.          END; (* with *)
  320.  
  321.          result := ( colour1 < colour2 ) ;
  322.          IF colour1 = colour2 THEN
  323.             IF CountPBPBits(PE1Ptr^.PrintBitPattern)
  324.                    > CountPBPBits(PE2Ptr^.PrintBitPattern) THEN
  325.                result := TRUE;
  326.             END;
  327.          END;
  328.          RETURN result;
  329.   END CompareComponents;
  330.  
  331.  
  332. PROCEDURE CompareCompEqual( PE1, PE2 : PaletteEntry ) : BOOLEAN;
  333.   VAR colour1, colour2 : CARDINAL;
  334.   BEGIN
  335.          WITH PE1 DO
  336.            colour1 := (   ( RedComponent   *   100   )
  337.                         + ( GreenComponent *    10   )
  338.                         + ( BlueComponent  *     1   ) )
  339.          END; (* with *)
  340.  
  341.          WITH PE2 DO
  342.            colour2 := (   ( RedComponent   *   100   )
  343.                         + ( GreenComponent *    10   )
  344.                         + ( BlueComponent  *     1   ) )
  345.          END; (* with *)
  346.  
  347.          RETURN ( colour1 = colour2 );
  348.   END CompareCompEqual;
  349.  
  350.  
  351. PROCEDURE SortByComponents ( VAR ppalette : PrintPalette; n : CARDINAL );
  352.   BEGIN
  353.     SortArrayWithKeys( ppalette, ppalette[0], LONG(n), CompareComponents );
  354.   END SortByComponents;
  355.  
  356.  
  357. (*----------------------------------------------------------------------*)
  358. (* Scan array from Brightest colours to halfway down the array setting  *)
  359. (* equal colour entries to the same print pattern from the previous     *)
  360. (* entry. Then scan up from the darkest colours to the middle setting   *)
  361. (* equal entries to the lower print bit pattern.                        *)
  362. (*                                                                      *)
  363. (*----------------------------------------------------------------------*)
  364. PROCEDURE MakeEntriesEqualForLowRes( VAR ppalette : PrintPalette );
  365.   VAR i,  middle : INTEGER;
  366.       finish     : BOOLEAN;
  367.   BEGIN
  368.     SortByComponents( ppalette, 16 );
  369.     
  370.     i := 1;
  371.     middle := 8;        (* number of last entry affected,
  372.                may not get changed if all entries different *)
  373.  
  374.     finish := FALSE;       (* scan from darker to lighter first *)
  375.     WHILE  ( i < 15 )
  376.      AND   NOT finish                       DO
  377.        IF CompareCompEqual(ppalette[i-1], ppalette[i]) THEN
  378.        ppalette[i].PrintBitPattern := ppalette[i-1].PrintBitPattern;
  379.            middle := i; (* last entry changed *)
  380.        ELSE
  381.            IF i > 8 THEN
  382.              finish := TRUE;
  383.            END;
  384.        END;
  385.        INC(i);
  386.     END;
  387.  
  388.     i := 14;
  389.     finish := FALSE;       (* scan from darker to lighter *)
  390.     WHILE  ( i > middle )  DO
  391.        IF CompareCompEqual(ppalette[i], ppalette[i+1]) THEN
  392.        ppalette[i].PrintBitPattern := ppalette[i+1].PrintBitPattern;
  393.        END;
  394.        DEC(i);
  395.     END;
  396.  
  397.   END MakeEntriesEqualForLowRes;
  398.  
  399.  
  400. PROCEDURE MakeEntriesEqualForMedRes( VAR ppalette : PrintPalette );
  401.   VAR i,  middle : INTEGER;
  402.       finish     : BOOLEAN;
  403.   BEGIN
  404.     SortByComponents( ppalette, 4 );
  405.     
  406.     i := 1;
  407.     middle := 1;        (* number of last entry affected,
  408.                may not get changed if all entries different *)
  409.  
  410.     finish := FALSE;       (* scan from darker to lighter first *)
  411.     WHILE  ( i < 3 )
  412.      AND   NOT finish                       DO
  413.        IF CompareCompEqual(ppalette[i-1], ppalette[i]) THEN
  414.        ppalette[i].PrintBitPattern := ppalette[i-1].PrintBitPattern;
  415.            middle := i; (* last entry changed *)
  416.        ELSE
  417.            IF i > 1 THEN
  418.              finish := TRUE;
  419.            END;
  420.        END;
  421.        INC(i);
  422.     END;
  423.  
  424.     i := 2;
  425.     finish := FALSE;       (* scan from  lighter to darker *)
  426.     WHILE  ( i > middle )  DO
  427.        IF CompareCompEqual(ppalette[i], ppalette[i+1]) THEN
  428.        ppalette[i].PrintBitPattern := ppalette[i+1].PrintBitPattern;
  429.        END;
  430.        DEC(i);
  431.     END;
  432.  
  433.   END MakeEntriesEqualForMedRes;
  434.  
  435.  
  436. (*----------------------------------------------------------------------*)
  437. (* Convert colours to print bit patterns for current low-res picture    *)
  438. (*----------------------------------------------------------------------*)
  439. PROCEDURE SetLowResDefaultPrintPalette ( VAR picturepalette : Palette;
  440.                                          VAR ppalette : PrintPalette );
  441.   VAR i         : INTEGER;
  442.  
  443.   BEGIN
  444.     FOR i := 0 TO 15 DO  (* initialise printpalette *)
  445.       ppalette[i].ColourIndex := i;
  446.       ColourComponents( picturepalette[i],
  447.                         ppalette[i].RedComponent,
  448.                         ppalette[i].GreenComponent,
  449.                         ppalette[i].BlueComponent );
  450.     END; (* for *)
  451.  
  452.     DCPicCnv.SortByColour( ppalette, 16 ); (* lightest colours to top *)
  453.  
  454.  
  455.     ppalette[00].PrintBitPattern := PrintBitPatternSet{            };
  456.     ppalette[01].PrintBitPattern := PrintBitPatternSet{          0 };
  457.     ppalette[02].PrintBitPattern := PrintBitPatternSet{       1    };
  458.     ppalette[03].PrintBitPattern := PrintBitPatternSet{    2       };
  459.     ppalette[04].PrintBitPattern := PrintBitPatternSet{ 3          };
  460.     ppalette[05].PrintBitPattern := PrintBitPatternSet{       1, 0 };
  461.     ppalette[06].PrintBitPattern := PrintBitPatternSet{    2,    0 };
  462.     ppalette[07].PrintBitPattern := PrintBitPatternSet{ 3,       0 };
  463.     ppalette[08].PrintBitPattern := PrintBitPatternSet{    2, 1    };
  464.     ppalette[09].PrintBitPattern := PrintBitPatternSet{ 3,    1    };
  465.     ppalette[10].PrintBitPattern := PrintBitPatternSet{ 3, 2       };
  466.     ppalette[11].PrintBitPattern := PrintBitPatternSet{    2, 1, 0 };
  467.     ppalette[12].PrintBitPattern := PrintBitPatternSet{ 3, 2,    0 };
  468.     ppalette[13].PrintBitPattern := PrintBitPatternSet{ 3,    1, 0 };
  469.     ppalette[14].PrintBitPattern := PrintBitPatternSet{ 3, 2, 1    };
  470.     ppalette[15].PrintBitPattern := PrintBitPatternSet{ 3, 2, 1, 0 };
  471.  
  472.     MakeEntriesEqualForLowRes( ppalette ); 
  473.  
  474.     DCPicCnv.SortByIndex( ppalette, 16 );
  475.  
  476.   END SetLowResDefaultPrintPalette;
  477.  
  478.  
  479. (*----------------------------------------------------------------------*)
  480. (* Convert colours to print bit patterns for a medium res picture       *)
  481. (*----------------------------------------------------------------------*)
  482. PROCEDURE SetMedResDefaultPrintPalette ( VAR picturepalette : Palette;
  483.                                          VAR ppalette : PrintPalette );
  484.   VAR i         : INTEGER;
  485.  
  486.   BEGIN
  487.    FOR i := 0 TO 15 DO  (* initialise printpalette *)
  488.       ppalette[i].ColourIndex := i;
  489.       ColourComponents( 0,    (* set all to black to sort to bottom *)
  490.                         ppalette[i].RedComponent,
  491.                         ppalette[i].GreenComponent,
  492.                         ppalette[i].BlueComponent );
  493.    END; (* for *)
  494.  
  495.    FOR i := 0 TO 3 DO  (* initialise printpalette *)
  496.       ColourComponents( picturepalette[i],
  497.                         ppalette[i].RedComponent,
  498.                         ppalette[i].GreenComponent,
  499.                         ppalette[i].BlueComponent );
  500.     END; (* for *)
  501.  
  502.     DCPicCnv.SortByColour( ppalette, 4 ); (* lightest colours to top *)
  503.  
  504.     ppalette[00].PrintBitPattern := PrintBitPatternSet{            };
  505.     ppalette[01].PrintBitPattern := PrintBitPatternSet{       1    };
  506.     ppalette[02].PrintBitPattern := PrintBitPatternSet{          0 };
  507.     ppalette[03].PrintBitPattern := PrintBitPatternSet{       1, 0 };
  508.  
  509.     MakeEntriesEqualForMedRes( ppalette ); 
  510.  
  511.     DCPicCnv.SortByIndex( ppalette, 16 );
  512.  
  513.   END SetMedResDefaultPrintPalette;
  514.  
  515. END DCConvrt.
  516.